home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / simcode.arc / VENTEL.PAS < prev    next >
Pascal/Delphi Source File  |  1985-01-19  |  14KB  |  618 lines
  1. {$symtab-,$linesize:131,$pagesize:86,$debug-,
  2. $title:'VENTEL.PAS -- Controller for the VENTEL Auto-Dialer'}
  3. {    COPYRIGHT @ 1982
  4.     Jim Holtman and Eric Holtman
  5.     35 Dogwood Trail
  6.     Randolph, NJ 07869
  7.     (201) 361-3395
  8. }
  9.  
  10. {$mathck-}
  11.  module ventel_or_hayes;
  12. {$include:'graph.inc'}
  13. {$include:'comm.inc'}
  14. {$include:'simterm.inc'}
  15. {$include:'util.inc'}
  16.  
  17.     type
  18.        menu_c = super array [1..*] of lstring(40);
  19.        board_data = record
  20.       last_state,successful_calls : integer;
  21.       comment : ^lstring;
  22.       tel_numbers : lstring(20);
  23.       end;
  24.  
  25.     const
  26.        MAX_NUMBERS = 700;
  27.  
  28.     var
  29.        [ external] telfile : text ;
  30.        bbs_numbers : boolean ;
  31.        max_bbs : integer ;
  32.        last_bbs : integer ;
  33.        char_graphics : boolean;
  34.        parity_mask : integer;
  35.        hayes_modem : boolean;
  36.  
  37.     var
  38.        used_numbers : integer;
  39.        c_state : array[0..10] of char;
  40.        cancel_command [public] : boolean;
  41.        boards : array[0..MAX_NUMBERS] of ^board_data;
  42.        bbs_filename [public] : lstring(64);
  43.  
  44.     const
  45.        NOT_CALLED = 0;
  46.        BUSY = 1;
  47.        NO_ANSWER = 2;
  48.        DEAD_PHONE = 3;
  49.        SUCCESS = 4;
  50.        REMOVE = 5;
  51.  
  52. value
  53.        c_state[NOT_CALLED] := '?';
  54.        c_state[BUSY] := 'B';
  55.        c_state[NO_ANSWER] := 'N';
  56.        c_state[DEAD_PHONE] := 'D';
  57.        c_state[SUCCESS] := 'S';
  58.        c_state[REMOVE] := 'R';
  59.        used_numbers := 0;
  60.        bbs_filename := '\simterm\boards';
  61.  
  62.     function menuit(var choices : menu_c;
  63.      const title : lstring ) : integer;
  64.  
  65.        external;
  66.  
  67.     function getc(exit_flag : LOOP_FLAG) : integer;
  68.  
  69.        external;
  70.  
  71.     procedure ck(a : integer;
  72.      const b : string);
  73.  
  74.        external;
  75.  
  76.     procedure savescreen;
  77.  
  78.        external;
  79.  
  80.     procedure restorescreen;
  81.  
  82.        external;
  83.  
  84.     function do_cancel : boolean [public];
  85.  
  86.        var
  87.       ch : char;
  88.  
  89.        begin
  90.       if (cancel_command = false) then 
  91.          if (xxinkey(ch) > 0) then cancel_command := true    ;
  92.       do_cancel := cancel_command;
  93.       end;
  94.  
  95.     procedure dial(var number : lstring) [public];
  96.                    {dial number on a ventel autodialer}
  97.  
  98.        var
  99.       ch : integer;
  100.  
  101.        procedure slow_send(const str : lstring);
  102.  
  103.       var
  104.          i : word;
  105.  
  106.       begin
  107.          for i:=1 to str.len do begin
  108.         send(str[i]);
  109.         send(chr(0)*chr(0)*chr(0));
  110.         end;
  111.          end;
  112.  
  113.        begin
  114.       writeln;
  115.       writeln;
  116.       writeln('Dialing...  ', number);
  117.       toggle_tr;
  118.       sleep(2);
  119.       if (hayes_modem = false) then begin
  120.          send(chr(13));
  121.                    {output character}
  122.          sleep(1);
  123.          send(chr(13));
  124.                    {output character}
  125.          sleep(1);
  126.          slow_send('k');
  127.          sleep(2);
  128.          slow_send(number);
  129.          send(chr(13));
  130.          end
  131.       else begin
  132.          send('ATDT');    {output character}
  133.          send(number);
  134.          send(chr(13));
  135.          end;
  136.       end;
  137.  
  138.     procedure do_success;
  139.  
  140.        var
  141.       inch : char;
  142.  
  143.        begin
  144.       writeln;
  145.       writeln('Success!!! (hit any key to terminate alarm)');
  146.       repeat
  147.          write(chr(7));
  148.          sleep(1);
  149.          until xxinkey(inch) > 0;
  150.       end;
  151.  
  152.     procedure eat_up_output;
  153.  
  154.        var
  155.       ch : integer;
  156.       wait_time : word;
  157.  
  158.        begin
  159.       wait_time := timer;
  160.       repeat
  161.          ch := getc(EXIT);
  162.          until (ch = 13) or ((timer-wait_time) > 3);
  163.       end;
  164.  
  165.     function is_answered(num : integer) : boolean [public];
  166.  
  167.        var
  168.       ch : integer;
  169.       inch : char;
  170.       wait_time : word;
  171.  
  172.        begin
  173.       write('Waiting for modem to start dialing...');
  174.       wait_time := timer;
  175.       repeat
  176.          if (timer-wait_time) > 30 then ch := ord('G')
  177.          else ch := getc(EXIT);
  178.          if do_cancel then begin
  179.         is_answered := false;
  180.         boards[num]^.last_state := DEAD_PHONE;
  181.         return;
  182.         end;
  183.          until ch > -1;
  184.       if (hayes_modem = false) then begin
  185.          while (ch <> ord('G')) do begin
  186.         repeat
  187.            ch := getc(EXIT);
  188.            until ((ch > -1) or do_cancel);
  189.         if do_cancel then begin
  190.            is_answered := false;
  191.            boards[num]^.last_state := DEAD_PHONE;
  192.            return;
  193.            end;
  194.         end;
  195.          end
  196.       else eat_up_output;
  197.       write('Waiting for answer...');
  198.       wait_time := timer;
  199.       while true do begin
  200.          with boards[num]^ do begin
  201.         case ord(ch) of
  202.            ord('O'),ord('C'): begin
  203.               is_answered := true;
  204.               do_success;
  205.               eat_up_output;
  206.               last_state := SUCCESS;
  207.               successful_calls := successful_calls + 1;
  208.               return;
  209.               end;
  210.            ord('B'): begin
  211.               is_answered := false;
  212.               writeln('Busy');
  213.               eat_up_output;
  214.               last_state := BUSY;
  215.               return;
  216.               end;
  217.            ord('D'): begin
  218.               is_answered := false;
  219.               writeln('Dead phone');
  220.               eat_up_output;
  221.               last_state := DEAD_PHONE;
  222.               return;
  223.               end;
  224.            ord('N'): begin
  225.               is_answered := false;
  226.               writeln('No answer');
  227.               eat_up_output;
  228.               last_state := NO_ANSWER;
  229.               return;
  230.               end;
  231.            otherwise ;
  232.            end;
  233.         end;
  234.  
  235.          repeat
  236.         if (timer-wait_time) > 30 then ch := ord('B')
  237.         else ch := getc(EXIT);
  238.         if do_cancel then begin
  239.            is_answered := false;
  240.            boards[num]^.last_state := DEAD_PHONE;
  241.            return;
  242.            end;
  243.         until ch > -1;
  244.          end;
  245.       writeln('Failed');
  246.       is_answered := false;
  247.       boards[num]^.last_state := DEAD_PHONE;
  248.       end;
  249.  
  250.     procedure parse_file(var infile : lstring);
  251.  
  252.        external;
  253.  
  254.     procedure ltrm(var s : lstring);
  255.  
  256.        var
  257.       i : integer;
  258.  
  259.        begin
  260.       while (s[1] in [chr(32), chr(9)]) and (s.len > 0) do begin
  261.          delete(s,1,1);
  262.          end;
  263.       end;
  264.  
  265.     procedure rtrm(var s : lstring);
  266.  
  267.        var
  268.       i : integer;
  269.  
  270.        begin
  271.       while (s[ord(s.len)] in [chr(32), chr(9)]) and (s.len > 0) do begin
  272.          s.len := s.len - 1;
  273.          end;
  274.       end;
  275.  
  276.     procedure write_file [public];
  277.  
  278.        var
  279.       i : integer;
  280.       filename : lstring(64);
  281.  
  282.        begin
  283.       if (bbs_numbers = false) then return;
  284.       filename := bbs_filename;
  285.       parse_file(filename);
  286.       assign(telfile, filename);
  287.       rewrite(telfile);
  288.       for i := 0 to max_bbs -1 do begin
  289.          with boards[i]^ do begin
  290.         if (last_state = REMOVE) then begin
  291.            if (comment <> nil) then dispose(comment);
  292.            dispose(boards[i]);
  293.            boards[i] := nil;
  294.            cycle;
  295.            end;
  296.         ltrm(tel_numbers);
  297.         write(telfile, last_state, successful_calls,' ', tel_numbers);
  298.         if (comment <> nil) then begin
  299.            writeln(telfile,'#',comment^);
  300.            dispose(comment);
  301.            comment := nil;
  302.            end
  303.         else writeln(telfile);
  304.         end;
  305.          dispose(boards[i]);
  306.          boards[i] := nil;
  307.          end;
  308.       close(telfile);
  309.       bbs_numbers := false;
  310.       end;
  311.  
  312.     procedure read_file;
  313.  
  314.        var
  315.       i : integer;
  316.       com_start : integer;
  317.       num_len : integer;
  318.       fts [static] : boolean;
  319.       buffer : lstring(128);
  320.       filename : lstring(64);
  321.  
  322.       value fts := true;
  323.  
  324.        begin
  325.       if (fts) then begin
  326.          for i := 0 to MAX_NUMBERS do boards[i] := nil;
  327.          fts := false;
  328.          end;
  329.       filename := bbs_filename;
  330.       parse_file(filename);
  331.       assign(telfile, filename);
  332.       reset(telfile);
  333.       i := 0;
  334.       while ((not eof(telfile)) and (i<MAX_NUMBERS)) do begin
  335.          new(boards[i]);
  336.          with boards[i]^ do begin
  337.         readln(telfile, last_state, successful_calls, buffer);
  338.         ltrm(buffer);
  339.         rtrm(buffer);
  340.         num_len := ord(buffer.len);
  341.         com_start := scaneq(num_len, '#', buffer, 1);
  342.         comment := nil;    {initialize}
  343.         if (com_start < num_len) then begin
  344.            new(comment, num_len);
  345.            copylst(buffer, comment^);
  346.            delete(comment^, 1, com_start+1);
  347.            delete(buffer, com_start+1, (num_len - com_start));
  348.            end;
  349.         copylst(buffer, tel_numbers);
  350.         end;
  351.          i := i + 1;
  352.          end;
  353.       max_bbs := i;
  354.       close(telfile);
  355.       last_bbs := -1;
  356.       bbs_numbers := true;
  357.       end;
  358.  
  359.     procedure call_next_bbs;
  360.  
  361.        var
  362.       i : integer;
  363.  
  364.        begin
  365.       if (bbs_numbers = false) then begin
  366.          read_file;
  367.          end;
  368.       last_bbs := last_bbs + 1;
  369.       if (last_bbs = max_bbs) then begin
  370.          writeln('Beginning at beginning of BBS list again! ');
  371.          last_bbs := 0;
  372.          end;
  373.       with boards[last_bbs]^ do begin
  374.          dial(tel_numbers);
  375.          eval(is_answered(last_bbs));
  376.          end;
  377.       end;
  378.  
  379.     procedure choose_number;
  380.  
  381.        var
  382.       i, x,y : integer;
  383.       resp : lstring(10);
  384.       ch : char;
  385.  
  386.        begin
  387.       if (bbs_numbers = false) then begin
  388.          read_file;
  389.          end;
  390.       xxcls;
  391.       for i := 0 to max_bbs -1 do begin
  392.          if (((i mod 22) = 0) ) then begin
  393.         if (i > 0) then begin
  394.            xxmove(20,23);
  395.            write('Hit return to finish listing (ESC to quit)....');
  396.            repeat
  397.               x := xxinkey(ch);
  398.               until ((x = 1) and ((ch = chr(13)) or (ch = chr(27))));
  399.            if (ch = chr(27)) then return;
  400.            end;
  401.         xxmove(0,0);
  402.         xxcls;
  403.         xxmove(6,0);
  404.         write('Number');
  405.         xxmove(25,0);
  406.         write('Last state');
  407.         xxmove(38,0);
  408.         writeln('Comment');
  409.         end;
  410.          with boards[i]^ do begin
  411.         write(i:3,') ',tel_numbers:18);
  412.         xrcurp(x,y);
  413.         xxmove(25,y);
  414.         case c_state[last_state] of
  415.            'B': write('Busy');
  416.            'N': write('No answer');
  417.            'D': write('Dead phone');
  418.            'S': write('Success');
  419.            'R': write('Removed');
  420.            '?': write('Not tried');
  421.            end;
  422.         xxmove(38,y);
  423.         if (comment <> nil) then write(comment^:-40);
  424.         writeln;
  425.         end;
  426.          end;
  427.       xxmove(20,23);
  428.       write('Which number (<cr> to exit) ? ');
  429.       readln(resp);
  430.       if (decode(resp, x) = true) then begin
  431.          if ((x> -1) and (x < max_bbs)) then begin
  432.         xxcls;
  433.         last_bbs := x;
  434.         dial(boards[x]^.tel_numbers);
  435.         eval(is_answered(x));
  436.         end;
  437.          end;
  438.       end;
  439.  
  440.     procedure print_number;
  441.  
  442.        var
  443.       i, x,y : integer;
  444.       resp : lstring(10);
  445.       ch : char;
  446.       pr : text;
  447.  
  448.        begin
  449.       if (bbs_numbers = false) then begin
  450.          read_file;
  451.          end;
  452.       assign(pr, 'lpt1:');
  453.       rewrite(pr);
  454.       for i := 0 to max_bbs -1 do begin
  455.          if ( (i mod 60) = 0) then begin
  456.         if (i > 0) then 
  457.            for x := 1 to 4 do writeln(pr)   ;
  458.         write(pr,'Number':-25);
  459.         write(pr,'Last state':-13);
  460.         writeln(pr,'Comment');
  461.         writeln(pr);
  462.         end;
  463.          with boards[i]^ do begin
  464.         write(pr,i:3,') ',tel_numbers:-20);
  465.         case c_state[last_state] of
  466.            'B': write(pr,'Busy':-13);
  467.            'N': write(pr,'No answer':-13);
  468.            'D': write(pr,'Dead phone':-13);
  469.            'S': write(pr,'Success':-13);
  470.            'R': write(pr,'Removed':-13);
  471.            '?': write(pr,'Not tried':-13);
  472.            end;
  473.         if (comment <> nil) then write(pr,comment^:-40);
  474.         writeln(pr);
  475.         end;
  476.          end;
  477.       close(pr);
  478.       end;
  479.  
  480.     procedure search_numbers;
  481.  
  482.        var
  483.       i : integer;
  484.       inch : char;
  485.       uncalled : integer;
  486.  
  487.        begin
  488.       srand;
  489.       xxcls;
  490.       writeln('Scanning BBS systems.......');
  491.  
  492.       if (bbs_numbers = false) then begin
  493.          read_file;
  494.          end;
  495.       uncalled := 0;
  496.       for i := 0 to max_bbs-1 do 
  497.          if (boards[i]^.last_state = NOT_CALLED) then uncalled := uncalled +
  498.           1   ;
  499.       i := 0;
  500.       repeat
  501.          xxmove(0,0);
  502.          xxcls;
  503.          if (uncalled = 0) then begin
  504.         writeln('Beginning at beginning of BBS list again! ');
  505.         for i := 0 to max_bbs -1 do begin
  506.                    if boards[i]^.last_state <> REMOVE then begin
  507.               boards[i]^.last_state := NOT_CALLED;
  508.               uncalled := uncalled+1;
  509.                  end;
  510.            end;
  511.         end;
  512.          repeat
  513.         i := rand(max_bbs) -1;
  514.         until boards[i]^.last_state = NOT_CALLED;
  515.          writeln('Dialing number ', i:4, ',  ',uncalled:3,' numbers remain')
  516.           ;
  517.          writeln('This board has been reached ', boards[i]^.
  518.           successful_calls:3, ' times in the past');
  519.          if (boards[i]^.comment <> nil) then writeln('Comment: ',boards[i]^.
  520.           comment^);
  521.          if do_cancel then begin
  522.         toggle_tr;
  523.         writeln('Aborted search');
  524.         break;
  525.         end;
  526.          dial(boards[i]^.tel_numbers);
  527.          last_bbs := i;
  528.          if do_cancel then begin
  529.         toggle_tr;
  530.         writeln('Aborted search');
  531.         break;
  532.         end;
  533.          uncalled := uncalled - 1;
  534.          until is_answered(i);
  535.       end;
  536.  
  537.     procedure do_ventels [public];
  538.  
  539.        var
  540.       inch : char;
  541.       choice : integer;
  542.       t : word;
  543.       menu [static] : menu_c(9);
  544.       value menu[1] := 'Scan bbs list until a hit';
  545.       menu[2] :='Write the bbs file';
  546.       menu[3] := 'Dial the next Board';
  547.       menu[4] := 'Delete the number you just dialed';
  548.       menu[5] := 'Print and choose a number';
  549.       menu[6]:= 'Enable character graphics';
  550.       menu[7] := 'Comment about last board';
  551.       menu[8] := 'Add new number';
  552.       menu[9] := 'Generate printer listing of boards';
  553.  
  554.        begin
  555.       cancel_command := false;
  556.       savescreen;
  557.       choice := menuit(menu, 'Ventel Dialing Options');
  558.       writeln;
  559.       case choice of
  560.          1: begin
  561.         search_numbers;
  562.         parity_mask := parity_mask or #80;
  563.         char_graphics := true;
  564.         end;
  565.  
  566.          2: 
  567.         if (bbs_numbers = true) then write_file   ;
  568.          3: call_next_bbs;
  569.          4: begin
  570.         if (last_bbs >= 0) then begin
  571.            write('Delete ',boards[last_bbs]^.tel_numbers,
  572.             '  Confirm(y/n)? ');
  573.            while (xxinkey(inch) = 0) do begin
  574.               end;
  575.            if (inch = 'y') then begin
  576.               boards[last_bbs]^.last_state := REMOVE;
  577.               end;
  578.            end;
  579.         end;
  580.          7: begin
  581.         writeln;
  582.         if (last_bbs >= 0) then begin
  583.            with boards[last_bbs]^ do begin
  584.               if (comment = nil) then new(comment,40);
  585.               write('Comment for number ',tel_numbers,' - ');
  586.               readln(comment^);
  587.               end;
  588.            end
  589.         else begin
  590.            writeln('You have not dialed a number to comment on');
  591.            sleep(2);
  592.            end;
  593.         end;
  594.          8: begin
  595.         if (bbs_numbers = false) then read_file;
  596.         writeln;
  597.         writeln('You must add "9 &" to allow dialing on a ventel');
  598.         write('New number - ');
  599.         new(boards[max_bbs]);
  600.         with boards[max_bbs]^ do begin
  601.            readln(tel_numbers);
  602.            last_state := NOT_CALLED;
  603.            successful_calls := 0;
  604.            comment := nil;
  605.            max_bbs := max_bbs + 1;
  606.            end;
  607.         end;
  608.          5: choose_number;
  609.          6: begin
  610.         parity_mask := parity_mask or #80;
  611.         char_graphics := true;
  612.         end;
  613.          9: print_number;
  614.          otherwise ;
  615.          end;
  616.       restorescreen;
  617.       end;     end.
  618.